home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / tpstuff1.arc / CWINDO.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-08-01  |  3.6 KB  |  132 lines
  1.  
  2. { Turbo Pascal removable window system }
  3. { Copyright 1984 Michael A. Covington  }
  4.  
  5. {Color and speed modifications by Michael D. Most, 7-26-85}
  6.  
  7. { For further documentation see PC Tech Journal, February 1985. }
  8.  
  9. { Requirements: IBM PC or close compatible.   }
  10. { Screen must be in text mode, on page 1,     }
  11. { either mono or color card.                  }
  12.  
  13. { Call INITWIN before calling MKWIN or RMWIN. }
  14.  
  15. const maxwin = 5;  { maximum number of windows open at once }
  16.  
  17. type imagetype  = array [1..4096] of char;
  18.      windimtype = record
  19.                     x1,y1,x2,y2,tc,tb: integer
  20.                   end;
  21. var
  22.   win: { Global variable package }
  23.     record
  24.       dim:    windimtype;  { Current window dimensions }
  25.       depth:  integer;
  26.       stack:  array[1..maxwin] of
  27.                 record
  28.                   image: imagetype;  { Saved screen image }
  29.                   dim:   windimtype; { Saved window dimensions }
  30.                   x,y:   integer     { Saved cursor position }
  31.                 end
  32.     end;
  33.  
  34.   crtmode:      byte      absolute $0040:$0049;
  35.   crtwidth:     byte      absolute $0040:$004A;
  36.   monobuffer:   imagetype absolute $B000:$0000;
  37.   colorbuffer:  imagetype absolute $B800:$0000;
  38.  
  39. procedure initwin;
  40.   { Records initial window dimensions }
  41. begin
  42.   with win.dim do
  43.     begin x1:=1; y1:=1; x2:=crtwidth; y2:=25 end;
  44.   win.depth:=0
  45. end;
  46.  
  47. procedure boxwin(x1,y1,x2,y2,tc,tb:integer);
  48.   { Draws a box, fills it with blanks, and makes it the current }
  49.   { window.  Dimensions given are for the box; actual window is }
  50.   { one unit smaller in each direction.                         }
  51.   { This routine can be used separately from the rest of the    }
  52.   { removable window package.                                   }
  53.   { Also adds color for text and background (MDM, 7-24-85)      }
  54. var x,y: integer;
  55. begin
  56.   window(1,1,80,25);
  57.   textcolor(tc); textbackground(tb);
  58.  
  59.   { Top }
  60.   gotoxy(x1,y1);
  61.   write(chr(213));
  62.   for x:=x1+1 to x2-1 do write(chr(205));
  63.   write(chr(184));
  64.  
  65.   { Sides }
  66.   for y:=y1+1 to y2-1 do
  67.     begin
  68.       gotoxy(x1,y); write(chr(179));
  69.       gotoxy(x2,y); write(chr(179));
  70.     end;
  71.  
  72.   { Bottom }
  73.   gotoxy(x1,y2);
  74.   write(chr(212));
  75.   for x:=x1+1 to x2-1 do write(chr(205));
  76.   write(chr(190));
  77.  
  78.   { Make it the current window and fill with selected color}
  79.   window(x1+1,y1+1,x2-1,y2-1);
  80.   clrscr;
  81.   gotoxy(1,1)
  82. end;
  83.  
  84. procedure mkwin(x1,y1,x2,y2,tc,tb:integer);
  85.   { Create a removable window }
  86.  
  87. begin
  88.   { Increment stack pointer }
  89.   with win do depth:=depth+1;
  90.   if win.depth>maxwin then
  91.     begin
  92.       writeln(^G,' Windows nested too deep ');
  93.       halt
  94.     end;
  95.  
  96.   { Save contents of screen }
  97.   if crtmode = 7 then
  98.     win.stack[win.depth].image := monobuffer
  99.   else
  100.     win.stack[win.depth].image := colorbuffer;
  101.  
  102.   win.stack[win.depth].dim := win.dim;
  103.   win.stack[win.depth].x   := wherex;
  104.   win.stack[win.depth].y   := wherey;
  105.  
  106.   { Create the window }
  107.   boxwin(x1,y1,x2,y2,tc,tb);
  108.   win.dim.x1 := x1+1;
  109.   win.dim.y1 := y1+1;    { Allow for margins }
  110.   win.dim.x2 := x2-1;
  111.   win.dim.y2 := y2-1;
  112.  
  113. end;
  114.  
  115. procedure rmwin;
  116.   { Remove the most recently created removable window }
  117.   { Restore screen contents, window dimensions, and   }
  118.   { position of cursor.  }
  119. begin
  120.   if crtmode = 7 then
  121.     monobuffer := win.stack[win.depth].image
  122.   else
  123.     colorbuffer := win.stack[win.depth].image;
  124.   with win do
  125.     begin
  126.       dim := stack[depth].dim;
  127.       window(dim.x1,dim.y1,dim.x2,dim.y2);
  128.       gotoxy(stack[depth].x,stack[depth].y);
  129.       depth := depth - 1
  130.     end
  131. end;
  132.